unit Monitor;

{$MODE Delphi}

{
  Внимание! Для успешной сборки необходим компонент
  CoolTrayIcon. Архив с ним находится в папке с исходниками
  В dpr файле проекта находится код запрещающий запуск второй копии
}

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,  StdCtrls, IdUDPServer, IdBaseComponent,
  IdComponent, IdUDPBase, IdUDPClient, IdSocketHandle, Menus, ExtCtrls,
  Buttons, Admin, ChangePassword, IdGlobal;

var
  SCEvent: THandle; //Event, оповещающий о наличии второй копии

const
  FILE_TESTNAME = 'Test.exe';
  FILE_EXAMNAME = 'Examen.exe';
  FILE_CFGNAME = 'Monitor.cfg';
  FILE_HOSTNAME = 'host.txt';
  HINT_EMPTY = 'Поле не заполнено!';
  MSG_SEC = WM_USER + 1; //Сообщение о том, что обнаружена 2 копия
  EVENT_NAME = 'EVENT_SECOND_COPY_OF_MONITOR';

type

  TOptions = packed record
    NumComp: integer;
    TestPath: string;
    ExamPath: string;
  end;

  { TfrmMonitor }

  TfrmMonitor = class(TForm)
    Client: TIdUDPClient;
    Server: TIdUDPServer;
    lblCompName: TLabel;
    cbCompNum: TComboBox;
    pmTrayIcon: TPopupMenu;
    miShowWindow: TMenuItem;
    miCloseApp: TMenuItem;
    Timer: TTimer;
    btnAccept: TBitBtn;
    btnSetDefaults: TBitBtn;
    gbPaths: TGroupBox;
    lblTestPath: TLabel;
    lblExamPath: TLabel;
    edTestPath: TEdit;
    edExamPath: TEdit;
    btnTestPathChange: TBitBtn;
    btnExamPathChange: TBitBtn;
    OpenDialog: TOpenDialog;
    btnChangePassword: TButton;
    Label1: TLabel;
    TrayIcon: TTrayIcon;
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ServerUDPRead(Sender: TObject; AData: TIdBytes;
      ABinding: TIdSocketHandle);
    procedure TrayIconDblClick(Sender: TObject);
    procedure miCloseAppClick(Sender: TObject);
    procedure miShowWindowClick(Sender: TObject);
    procedure FormHide(Sender: TObject);
    procedure TimerTimer(Sender: TObject);
    procedure btnAcceptClick(Sender: TObject);
    procedure btnSetDefaultsClick(Sender: TObject);
    procedure btnTestPathChangeClick(Sender: TObject);
    procedure btnExamPathChangeClick(Sender: TObject);
    procedure cbCompNumChange(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btnChangePasswordClick(Sender: TObject);
  private
    fOptions: TOptions;
    IsFirstRun: boolean; //истина если программа только что запущена
    function GrabOptions: TOptions;
    procedure SetOptions;
    function LoadFromFile: TOptions;
    procedure SaveToFile;
    procedure StartExam(params: string);
    procedure StartTest;
    procedure OnSecCopyOpen(var Msg: TMessage); message MSG_SEC;
  public
  end;

  function GetExePath(): string;

var
  frmMonitor: TfrmMonitor;

implementation

{$R *.lfm}

uses
  EventWait;

type

  TParsedMsg = record
  {
    Результат разбора сообщения, пришедшего по сети
    Порт - 1024
  }
    MsgType: integer; //Тип
    Inf: string //Полезная информация
  end;

function ParseMsg(const Msg: string): TParsedMsg;
{
  Разбор сообщения. Подробности см в "Протокол EEM.txt"
  Типы:
    -1 - неопределённость
    0 - запрос соединения
    1 - начать экзамен
    2 - начать тест
}
begin
  if msg[1] = chr(0) then Result.MsgType := 0 else
    if msg[1] = chr(1) then Result.MsgType := 1 else
      if msg[1] = chr(2) then Result.MsgType := 2 else
        Result.MsgType := -1;
  Result.Inf := Copy(Msg, 2, Length(Msg)-1);
end;

function TfrmMonitor.GrabOptions: TOptions;
{
  Получение настроек с контролов
}
begin
  with Result do
  begin
    NumComp := StrToInt(cbCompNum.Text);
    TestPath := edTestPath.Text;
    ExamPath := edExamPath.Text;
  end;
end;

procedure TfrmMonitor.FormShow(Sender: TObject);
begin
  if Not FileExists(GetExePath + FILE_CFGNAME) { *Converted from FileExists*  } then //Проверка наличия конфига.
    btnSetDefaultsClick(self)          
  else
  begin
    fOptions := LoadFromFile;           //Иначе загрузка настроек
    SetOptions;                                                                 
  end;
  if not Server.Active then Server.Active := true;   //Запуск сети
  if not Client.Active then Client.Active := true;
  if not IsFirstRun then
    if Admin.frmLogin.ShowModal <> mrOk then Timer.Enabled := true;
end;

function TfrmMonitor.LoadFromFile: TOptions;
{
  Загрузка настроек из файла и
  сохранение их в структуру TOptions
}
var
  s: TStringList;
  p: integer;
begin
  s := TStringList.Create;
  s.LoadFromFile(GetExePath() + FILE_CFGNAME);
  p := Pos(' ', s.Strings[0]) + 1;
  result.NumComp := StrToInt(Copy(s.Strings[0], p, Length(s.Strings[0]) + 1 - p));
  p := Pos(' ', s.Strings[1]) + 1;
  result.TestPath := Copy(s.Strings[1], p, Length(s.Strings[1]) + 1 - p);
  p := Pos(' ', s.Strings[1]) + 1;
  result.ExamPath := Copy(s.Strings[2], p, Length(s.Strings[2]) + 1 - p);
  s.Free;
end;

procedure TfrmMonitor.SaveToFile;
{
  Сохранение настроек в файл из структуры TOptions
}
var
  s: TStringList;
begin
  s := TStringList.Create;
  s.Add('NumComp ' + IntToStr(fOptions.NumComp));
  s.Add('TestPath ' + fOptions.TestPath);
  s.Add('ExamPath ' + fOptions.ExamPath);
  s.SaveToFile(GetExePath() + FILE_CFGNAME);
  s.Free;
end;

procedure TfrmMonitor.SetOptions;
{
  Установка значений контролов в соотв с TOptions
}
begin
  cbCompNum.ItemIndex := fOptions.NumComp - 1;
  edExamPath.Text := fOptions.ExamPath;
  edTestPath.Text := fOptions.TestPath;
end;

procedure TfrmMonitor.StartExam(params: string);
begin
  WinExec(PAnsiChar(fOptions.ExamPath + params), SW_SHOW);
end;

procedure TfrmMonitor.StartTest;
begin
  WinExec(PAnsiChar(fOptions.TestPath), SW_SHOW);
end;

procedure TfrmMonitor.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := caNone;         //По умолчанию форма не закрывается,
  frmMonitor.Hide;    //а сворачивается в трей
end;

procedure TfrmMonitor.ServerUDPRead(Sender: TObject; AData: TIdBytes;
  ABinding: TIdSocketHandle);
  var
    Msg: String;
    Length, i: integer;
    ParsedMsg: TParsedMsg;
    Str: TStringList;
  begin
    msg := '';                              //Здесь читается
    for i := Low(AData) to High(AData) do   //пришедшее из сети
      msg := msg + chr(AData[i]);           //сообщение
    ParsedMsg := ParseMsg(Msg);             //Разбор сообщения
    case ParsedMsg.MsgType of
      -1: exit;                        //Если тип неопределён - ничего не делать
      0:
      begin                                                //Если это  установка
        Client.Host := ABinding.PeerIP;                    //связи, то
        Client.Send(chr(3) + IntToStr(fOptions.NumComp));  //отправить подтвержденик
        str := TStringList.Create;
        Str.Add(ABinding.PeerIP);                          //Записать IP сервера
        Str.SaveToFile(GetExePath + FILE_HOSTNAME);        //в host.txt
        Str.Free;
      end;
      1: StartExam(ParsedMsg.Inf);
      2: StartTest;
    end;
end;

procedure TfrmMonitor.TrayIconDblClick(Sender: TObject);
begin
  frmMonitor.Show; //При даблклике по значку в трее форма разворачивается
end;

{----------------------------------------------------------------------}
//Начало обработки выбора пунктов контекстного меню иконки в трее
procedure TfrmMonitor.miCloseAppClick(Sender: TObject);
begin
  Application.Terminate;
end;

procedure TfrmMonitor.miShowWindowClick(Sender: TObject);
begin
  frmMonitor.Show;
end;
//Обработка закончена
{_______________________________________________________________________}

procedure TfrmMonitor.FormHide(Sender: TObject);
begin
  frmMonitor.Hide;
end;

procedure TfrmMonitor.TimerTimer(Sender: TObject);
{
  По таймеру автоматически сворачивается в трей форма
  Это криво, но пока будет так
}
begin
  Timer.Enabled := false;
  frmMonitor.Hide;
  if IsFirstRun then IsFirstRun := false;
end;

procedure TfrmMonitor.btnAcceptClick(Sender: TObject);
begin
  fOptions := GrabOptions;
  SaveToFile;
  btnAccept.Enabled := false;
end;

{----------------------------------------------------------------------}
//Обработка нажатий на кнопки в главном окне

procedure TfrmMonitor.btnSetDefaultsClick(Sender: TObject);
begin
  cbCompNum.ItemIndex := 0;
  edExamPath.Text := GetExePath + FILE_EXAMNAME;
  edTestPath.Text := GetExePath + FILE_TESTNAME;
  fOptions := GrabOptions;
  SaveToFile;
end;

procedure TfrmMonitor.btnTestPathChangeClick(Sender: TObject);
begin
  if OpenDialog.Execute then edTestPath.Text := OpenDialog.FileName;
  btnAccept.Enabled := true;
end;

procedure TfrmMonitor.btnExamPathChangeClick(Sender: TObject);
begin
  if OpenDialog.Execute then edExamPath.Text := OpenDialog.FileName;
  btnAccept.Enabled := true;
end;

//Окончание обработки
{_____________________________________________________________________}

procedure TfrmMonitor.OnSecCopyOpen(var Msg: TMessage);
{
  Обработчик сообщения MSG_SEC
}
begin
  frmMonitor.Show;
end;

procedure TfrmMonitor.cbCompNumChange(Sender: TObject);
begin
  btnAccept.Enabled := true;
end;

procedure TfrmMonitor.FormCreate(Sender: TObject);
begin
  EventWait.EventWaitThread.Create(false); //Запускаем поток который ждёт Event
  IsFirstRun := true;
end;

procedure TfrmMonitor.btnChangePasswordClick(Sender: TObject);
begin
  frmChangePass.ShowModal;
end;

function GetExePath: string; //Получаем путь к папке
var                          //В конце пути ЕСТЬ символ '\'
  i: integer;
  TempStr: string;
begin
  TempStr := Application.ExeName;
  for i := Length(TempStr) downto 1 do
    if TempStr[i] = '\' then
    begin
      result := copy(TempStr, 1, i);
      exit;
    end;
end;

end.
